home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 7
/
FM Towns Free Software Collection 7.iso
/
fb386
/
shadow
/
shadow.bas
next >
Wrap
BASIC Source File
|
1993-11-30
|
3KB
|
76 lines
1000 ' save "shadow.bas",a
1010 '------------------------------------------
1020 ' 影文字作成 1
1030 ' 1993/08/04 by TMA
1040 ' with Marty Basic Runtime CD
1050 '------------------------------------------
1060 x = 20 ' 開始位置
1070 y = 80
1080 fwid = 10 ' 文字間隔
1090 '
1100 *rep
1110 cls
1120 input "文字列,倍率,高さ,形式(0:標準 2:斜体) : ",s$,sz,lcnt,ftype
1130 cw = sz * 3 ' 文字間隔
1140 '-----------------------------------------
1150 cls
1160 gosub *dr1
1170 gosub *dr2
1180 gosub *mktiff
1190 gosub *clreol
1200 print "Hit any Key (Continue = c) :";: a$=input$(1)
1210 if a$="c" or a$ ="C" then *rep else end
1220 '------------------------------------------
1230 *dr1 ' 下地描画
1240 for i = 0 to lcnt step 0.5
1250 symbol (x+i ,y+i+1),s$,sz,sz,7,0,PSET,ftype,cw
1260 symbol (x+i+1,y+i ),s$,sz,sz,7,0,PSET,ftype,cw
1270 next
1280 return
1290 *dr2 ' 描画
1300 for i = 0 to 4
1310 symbol (x+i,y+i),s$,sz,sz,7,0,XOR,ftype,cw
1320 gosub *clreol
1330 print "Make file:f / Next:CR :";:a$=input$(1): print a$
1340 if a$ ="f" or a$="F" then gosub *mktiff ' file save
1350 next
1360 return
1370 '
1380 *mktiff ' Tiff save
1390 gosub *clreol
1400 print "SAVE範囲を左上、右下の順にクリックしてください。(中止:右クリック2回)"
1410 sp = 0: can = 0
1420 mouse 0: mouse 1,,,1
1430 while sp <> 4
1440 if mouse(2,0) or mouse(2,1) then gosub *getmp
1450 wend
1460 if can = 1 then color 2:print "Canceled": wait 100: color 7:return
1470 line(p(0),p(1))-(p(2),p(3)),pset,5,B
1480 f$=""
1490 gosub *clreol
1500 input "save filename ( with '.TIF' ,Cansel=CR) :",f$
1510 line(p(0),p(1))-(p(2),p(3)),preset,5,B
1520 if f$="" then return
1530 on error goto *ertr ' 同一名称はエラー
1540 save@ f$, (p(0),p(1))-(p(2),p(3))
1550 on error goto 0
1560 mouse 1,,,0 ' マウス 消去
1570 return
1580 '
1590 *getmp ' マウス イチ シュトク
1600 if mouse(2,1) = -1 THEN CAN = 1 ELSE CAN = 0 ' cansel ?
1610 p(sp) = mouse(4,0): p(sp+1) = mouse(5,0)
1620 sp = sp + 2
1630 if sp=2 then pset(p(0),p(1)),5 :beep:wait 100
1640 return
1650 '
1660 *clreol ' ギョウ ノ オワリマデ clr
1670 locate 0,0: print space$(78);
1680 locate 0,0
1690 locate 1,0: print space$(78);
1700 locate 1,0
1710 return
1720 *ertr
1730 if err =64 then kill f$ else ? "err,erl :" err,erl stop
1740 resume